home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d19 / prowho15.arc / PROWHO.PAS < prev    next >
Pascal/Delphi Source File  |  1988-11-09  |  4KB  |  172 lines
  1.  
  2. (*
  3.  * ProWho.PAS - Door to answer the question: Who uploaded that file?
  4.  *
  5.  * (C) 1988 Samuel H, Smith (05-Feb-88)
  6.  *
  7.  * revision history:
  8.  *   2-19-88  initial coding
  9.  *
  10.  *)
  11.  
  12. {$M 12000,20000,20000}  {Stack, minheap, maxheap}
  13. {$L-}                   {Don't link in ram}
  14. {$T+}                   {Make mapfile}
  15. {$V-}                   {Relax string rules}
  16.  
  17. Program WhoUploaded;
  18.  
  19. {$i prokit.inc}    {include standard 'uses' statement}
  20.  
  21. const
  22.    version = 'ProWho v1.5, 10-08-88 (C)1988 S.H.Smith';
  23.  
  24.    shortest = 3;        {shortest search key allowed}
  25.  
  26. var
  27.    buffer:              array[1..10240] of char;
  28.  
  29.    driver:              string;   {driver type; taken care of automatically}
  30.    download_file:       string;   {download listing file}
  31.    welcome_file:        string;   {welcome message file}
  32.    menu_file:           string;   {main menu file}
  33.    close_file:          string;   {closing message file}
  34.  
  35.  
  36. (* ---------------------------------------------------------------- *)
  37. procedure load_info;
  38.    {load the latest configuration file}
  39. var
  40.    fd: text;
  41. begin
  42.    assignText(fd,config_file);
  43.    reset(fd);
  44.    readln(fd,driver);
  45.    readln(fd,download_file);
  46.    readln(fd,welcome_file);
  47.    readln(fd,menu_file);
  48.    readln(fd,close_file);
  49.    close(fd);
  50. end;
  51.  
  52.  
  53. (* ---------------------------------------------------------------- *)
  54. procedure locate_file(name: string);
  55. var
  56.    fd:     text;
  57.    line:   string;
  58.    uline:  string;
  59.    i:      integer;
  60.    recs:   integer;
  61.    downs:  integer;
  62.    ups:    integer;
  63.    hits:   integer;
  64.  
  65. begin
  66.    AssignText(fd,download_file);
  67.    {$i-} reset(fd); {$i+}
  68.    if ioresult <> 0 then
  69.    begin
  70.       displn(RED+'Can''t access data file.  Sorry!');
  71.       exit;
  72.    end;
  73.  
  74.    SetTextBuf(fd,buffer);
  75.    downs := 0;
  76.    ups := 0;
  77.    hits := 0;
  78.    recs := 0;
  79.    stoupper(name);
  80.    make_log_entry('Searching for ('+name+') ...',true);
  81.    newline;
  82.  
  83.    while (eof(fd)=false) and (nomore = false) and (dump_user = false) do
  84.    begin
  85.       inc(recs);
  86.       case (recs mod 300) of
  87.           1: disp('.');
  88.         200: disp(^H' '^H);
  89.       end;
  90.  
  91.       readln(fd,line);
  92.       uline := line;
  93.       stoupper(uline);
  94.       i := pos(name,uline);
  95.       if i > 0 then
  96.       begin
  97.          displn(^M+WHITE+copy(line,1,i-1)+
  98.                    RED  +name+
  99.                    WHITE+copy(line,i+length(name),255));
  100.  
  101.          inc(hits);
  102.          if pos('(U)',uline) > 0 then inc(ups);
  103.          if pos('(D)',uline) > 0 then inc(downs);
  104.       end;
  105.    end;
  106.  
  107.    close(fd);
  108.    newline;
  109.  
  110.    disp(GREEN+itoa(recs)+' entries scanned, '+itoa(hits)+' matches');
  111.    if ups > 0 then   disp(', '+itoa(ups)+' uploads');
  112.    if downs > 0 then disp(', '+itoa(downs)+' downloads');
  113.    displn('.');
  114.  
  115.    newline;
  116. end;
  117.  
  118.  
  119. (* ---------------------------------------------------------------- *)
  120. procedure main_menu;
  121.    {main procedure}
  122. begin
  123.  
  124.    repeat
  125.       force_enter;
  126.       display_file(menu_file);
  127.  
  128.       display_time_left;
  129.       disp('Enter the Text to Scan for: (Q)=quit? ');
  130.  
  131.       get_cmdline;              {get cmdline, map to upper case}
  132.       newline;
  133.  
  134.       if cmdline = 'Q' then
  135.          exit;
  136.  
  137.       if length(cmdline) < shortest then
  138.          displn('Please enter a longer search key!')
  139.       else
  140.       if is_wild(cmdline) then
  141.          displn('Wildcards won''t work!  Use keywords only.')
  142.       else
  143.          locate_file(cmdline);
  144.  
  145.    until dump_user or (minutes_left < 1);
  146.  
  147. end;
  148.  
  149.  
  150. (* ---------------------------------------------------------------- *)
  151.  
  152. begin  {main block}
  153.    init;     {must be first - opens com port, loads setup and user data}
  154.  
  155.    newline;
  156.    displn(version);
  157.    load_color_constants('PROCOLOR');
  158.                             {use 'PROCOLOR' to redefine colors; defaults used
  159.                              if this file is missing}
  160.  
  161.    progname := 'ProWho';    {program name on status line, must be 7 characters}
  162.    load_info;               {load info from config file}
  163.  
  164.    display_file(welcome_file);
  165.  
  166.    main_menu;              
  167.    display_file(close_file);
  168.  
  169.    uninit;   {must be last - closes com port and updates database}
  170. end.
  171.  
  172.